Shareware Grab Bag

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / pssst.arc / PSDELETP.PRG < prev next >

Wrap

Text File | 1986-07-17 | 12.0 KB | 327 lines

* PSDELETP.PRG * * A DBASE II 16BIT COMMAND FILE to allow deletion of records from * the PHONE datafile. The selection may be the scan mode which * allows viewing/deleting, either by selecting a letter or going through * the entire alphabet letter by letter. * * Version 1 * By LTC Denny Hugg * ANGSC/DOS Andrews AFB MD 16 Jul 1985 * * Version 2 * modified by Maj Jim McMurry * ANGSC/DOSC Truax Field, WI 15 Jun 1986 * * --- makes extensive use of the technique where we write to the last * --- column of line 22 to get the display on line 23 without screen jump. * * USE PSPHONE GO BOTTOM * --- for use in checking if selected record is in range STORE # TO last * --- displays will be alphabetical based on last name as that is how * --- PSPHONEI is indexed. Deletions will be automatically updated USE PSPHONE INDEX PSPHONEI * --- we won't pack unless a deletion has been made STORE 'N' TO needpack STORE ' ' TO mlname DO WHILE T SET EXACT ON GO TOP ERASE IF mlname = ' ' STORE 'TELEPHONE RECORD VIEW/DELETE'; TO heading DO PSHEADING STORE ' ' TO select * --- done this way so the record will be re-displayed with asterisk @ 0, 0 SAY gcuron @ 22,79 SAY ' Enter Name To Delete, (S)can , Or '; +'<RETURN> To Exit '; GET select PICTURE '!!!!!!!!!!!' READ NOUPDATE @ 0, 0 SAY gcuroff ENDIF IF select = ' ' IF needpack = 'N' @ 22,79 SAY gclearline @ 10, 0 SAY ' ' STORE 10 TO line STORE 'No Last Name Entered ' + gfirstname + ; + ' Returning To Phone Menu' TO prompt DO PSPROMPT STORE 1 TO counter DO WHILE counter < gdelay STORE counter + 1 TO counter ENDDO ELSE ERASE STORE ' ' TO select @ 22,12 SAY 'Permanently Delete Records Marked '; +'This Session? (Y/N) '; GET select PICTURE '!' READ @ 22, 0 SAY gclearline IF select = 'N' STORE 10 TO line STORE 'Removing Deletion Flags From Marked Records' TO prompt DO PSPROMPT RECALL ALL ELSE STORE 10 TO line STORE 'Permanently Deleting Marked Records '+gfirstname TO prompt DO PSPROMPT PACK ENDIF ENDIF USE RELEASE ALL EXCEPT g* SET EXACT OFF RETURN ENDIF IF $(select,1,1) = ' ' * --- he added some leading space(s) STORE 1 TO pointer * --- locate the first non-empty character DO WHILE $(select,pointer,1) = ' ' STORE pointer + 1 TO pointer ENDDO * --- get the non-empty characters STORE $(select,pointer,LEN(select)-pointer + 1) TO select ENDIF RELEASE pointer STORE TRIM(select) TO mlname * --- give the guy a way out DO CASE CASE mlname <> 'S' ERASE STORE 1 TO line STORE 'SEARCH BY LAST NAME' TO prompt DO PSPROMPT FIND &mlname IF # = 0 @ 22,79 SAY ' '+; 'That Name Is Not In The Database' STORE 0 TO counter DO WHILE counter < gdelay STORE counter + 1 TO counter ENDDO STORE ' ' TO mlname * --- get back a little quicker LOOP ELSE @ 4, 0 SAY 'Rec # Last Name First Rank O/S U #'; +' Type Location Phone' @ 5, 0 SAY gline @ 5,78 SAY ' ' STORE 0 TO line DO WHILE .NOT. EOF .AND. !(lname) = mlname * --- stops the screen after a screenful or two - can be expanded if necessary * --- but that would take more than 29 Smith or Jones' IF line = 8 .OR. line = 19 @ 22,79 SAY ' '+; 'More To Come ... Strike Any Key To Continue' SET CONSOLE OFF WAIT SET CONSOLE ON ERASE STORE 1 TO line STORE 'SEARCH BY LAST NAME' TO prompt DO PSPROMPT @ 4, 0 SAY 'Rec # Last Name First Rank O/S U #'; +' Type Location Phone' @ 5, 0 SAY gline @ 5,78 SAY ' ' STORE 0 TO line ENDIF IF * SKIP LOOP ENDIF DISPLAY ' '+lname+' '+fname+' '+rank+' '+; offsym+' '+unitno+' '+unitype+' '+icao+; ' '+state+' '+avnop+'-'+avnos STORE line + 1 TO line SKIP ENDDO STORE '1' TO recno STORE ' ' TO select @ 0, 0 SAY gcuron @ 22,79 SAY ' '+; 'Enter # To Delete Or <RETURN> To Try Another Name '; GET select PICTURE '99999' READ NOUPDATE @ 0, 0 SAY gcuroff @ 22,79 SAY gclearline IF select = ' ' STORE ' ' TO mlname LOOP ENDIF IF $(select,1,1) = ' ' * --- he added some leading space(s) STORE 1 TO pointer * --- locate the first non-empty character DO WHILE $(select,pointer,1) = ' ' STORE pointer + 1 TO pointer ENDDO * --- get the non-empty characters STORE $(select,pointer,LEN(select)-pointer + 1) TO select ENDIF RELEASE pointer STORE TRIM(select) TO recno IF recno <> ' ' * --- check if there's a number that big IF VAL(recno) > last @ 22,79 SAY gclearline @ 22,79 SAY ' '+; 'There Is No '+recno+' ... Try Again' STORE 0 TO counter DO WHILE counter < gdelay STORE counter + 1 TO counter ENDDO ELSE @ 22,79 SAY gclearline @ 22,79 SAY ' '+; 'Marking Record '+recno+' For Deletion' STORE 0 TO counter DO WHILE counter < gdelay STORE counter + 1 TO counter ENDDO @ 22,79 SAY gclearline GO VAL(recno) DELETE STORE 'Y' TO needpack STORE ' ' TO mlname ENDIF ENDIF ENDIF CASE mlname = 'S' SET EXACT OFF @ 22,79 SAY gclearline STORE ' ' TO choice @ 22,79 SAY ' '; +'Letter To Scan Or <Return> For All '; GET choice PICTURE '!' READ NOUPDATE IF choice = ' ' STORE 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' TO letters STORE 1 TO loops DO WHILE loops <= 26 ELSE STORE choice TO letters STORE 1 TO loops DO WHILE loops <= 1 ENDIF ERASE STORE $(letters,loops,1) TO scan STORE 1 TO line STORE 'SCANNING FIRST LETTER ' + scan TO prompt DO PSPROMPT FIND &scan STORE loops + 1 TO loops IF !($(lname,1,1)) <> scan STORE 10 TO line STORE 'There Are No Names Beginning With ' + scan TO prompt DO PSPROMPT STORE 1 TO counter DO WHILE counter < gdelay STORE counter + 1 TO counter ENDDO @ 9, 0 SAY gclearline @ 10, 0 SAY gclearline @ 11, 0 SAY gclearline ELSE @ 4, 0 SAY 'Rec # Last Name First Rank O/S U #'; +' Type Location Phone' @ 5, 0 SAY gline @ 5,78 SAY ' ' STORE 0 TO line DO WHILE .NOT. EOF .AND. !($(lname,1,1)) = scan IF line = 8 .OR. line = 19 @ 22,79 SAY ' '+; 'More To Come ... Strike Any Key To Continue' SET CONSOLE OFF STORE 1 TO line STORE 'SCANNING FIRST LETTER ' + scan TO prompt WAIT SET CONSOLE ON ERASE DO PSPROMPT @ 4, 0 SAY 'Rec # Last Name First Rank O/S U #'; +' Type Location Phone' @ 5, 0 SAY gline @ 5,78 SAY ' ' STORE 0 TO line ENDIF IF * SKIP LOOP ENDIF DISPLAY ' '+lname+' '+fname+' '+rank+' '+; offsym+' '+unitno+' '+unitype+' '+icao+; ' '+state+' '+avnop+'-'+avnos STORE line + 1 TO line SKIP ENDDO STORE ' ' TO select @ 0, 0 SAY gcuron @ 22,79 SAY ' '+; 'Enter # To Delete Or <RETURN> To Continue '; GET select PICTURE '99999' READ NOUPDATE @ 0, 0 SAY gcuroff @ 22,79 SAY gclearline IF select <> ' ' IF $(select,1,1) = ' ' * --- he added some leading space(s) STORE 1 TO pointer * --- locate the first non-empty character DO WHILE $(select,pointer,1) = ' ' STORE pointer + 1 TO pointer ENDDO * --- get the non-empty characters STORE $(select,pointer,LEN(select)-pointer + 1) TO select ENDIF STORE TRIM(select) TO recno IF VAL(recno) > last @ 22,79 SAY gclearline @ 22,79 SAY ' '; +'There Is No '+select+' ... Try Again' STORE 0 TO counter DO WHILE counter < gdelay STORE counter + 1 TO counter ENDDO ELSE * --- we'll send him back to same letter to display asterisk and give him * --- a chance to delete another of the same first letter STORE TRIM(select) TO select STORE loops - 1 TO loops @ 22,79 SAY ' '+; 'Record '+select+' Marked For Deletion' STORE 1 TO counter DO WHILE counter < gdelay STORE counter + 1 TO counter ENDDO @ 22,79 SAY gclearline GO VAL(recno) DELETE STORE 'Y' TO needpack ENDIF ELSE STORE ' ' TO mlname ENDIF ENDIF ENDDO ENDCASE ENDDO T * --- EOF PSDELETP.PRG gdelay STORE counter + 1 TO counter ENDDO ELSE @ 22,79 SAY gclearline @ 22,79 SAY ' '+; 'Marking Record '+recn